Celestin Apprentice 5/Apprentice-Release5.iso/Environments/PowerMacOberon feb96/Dialogs/MoreMathL.Mod

Oberon Text | 1995-06-30 | 6.7 KB | 168 lines | [TEXT/.Ob4]

Syntax10.Scn.Fnt
InfoElems
Alloc
Syntax10.Scn.Fnt
StampElems
Alloc
8 Feb 95
"Title": MoreMathL
"Author": Christoph Steindl (CS)
"Abstract": Implementation of the mathematical functions not exported by MathL. The previously used
    MathLib shipped with the Metrowerks C-Compiler was slow and inaccurate.
"Keywords": trigonimetric functions, inverse trigonometric functions, hyperbolic functions, inverse
    hyperbolic functions, IEEE floating-point format
"Version": 1.0
"From":  11.11.94 15:40:26
"Until":
"Changes":
"Hints": This text can again contain arbitrary text elements!
Syntax10i.Scn.Fnt
StampElems
Alloc
8 Feb 95
FoldElems
Syntax10.Scn.Fnt
Floating point format according to the IEEE standard
Courier10.Scn.Fnt
Syntax10.Scn.Fnt
Implementation hierarchy
KeplerElems
Alloc
KeplerGraphs
GraphDesc
KeplerGraphs
StarDesc
KeplerFrames
CaptionDesc
Syntax10.Scn.Fnt
Kepler1
AttrDesc
Cosin
Syntax10.Scn.Fnt
ArcTan
Syntax10.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10.Scn.Fnt
Tangens
Syntax10.Scn.Fnt
Cotangens
Syntax10.Scn.Fnt
ArcSin
Syntax10.Scn.Fnt
ArcCot
Syntax10.Scn.Fnt
ArcCos
Syntax10.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10.Scn.Fnt
ArcTanh
Syntax10.Scn.Fnt
ArcSinh
Syntax10.Scn.Fnt
ArCosh
Syntax10.Scn.Fnt
ArCoth
Syntax10.Scn.Fnt
"exported from MathL"
Syntax10.Scn.Fnt
Kepler1
LineDesc
Syntax10b.Scn.Fnt
MODULE MoreMathL;
    (* Christoph Steindl (CS), 11.11.94 -
IMPORT SYSTEM, MathL;
CONST
    piOver2 = MathL.pi / 2;
    Floating point format according to the IEEE standard:
    single precision: S EEEEEEEE MMMMMMMMMMMMMMMMMMMMMMM
        1 bit for the sign
        8 bits for the exponent
        23 bits for the mantissa
        ____________________________________________________________________________________________________
        32 bits = 4 bytes for one single precision floating point number
        The exponent is stored as an unbiased exponent, to get the real exponent (within range -126..127) you have to
        subtract 127 from the resulting number).
        The number 0 is represented as exponent = 0 and mantissa = 0.
        An exponent of 255 and a mantissa of 0 denotes infinity.
        An exponent of 255 and a mantissa of #0 denotes NaN.
    double precision: S EEEEEEEEEEE MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM
        1 bit for the sign
        11 bits for the exponent
        52 bits for the mantissa
        ______________________________________________________________________________________________________
        64 bits = 8 bytes for one double precision floating point number
        The exponent is stored as an unbiased exponent, to get the real exponent (within range -1022..1024) you have
        to subtract 1023 from the resulting number).
        The number 0 is represented as exponent = 0 and mantissa = 0.
        An exponent of 2047 and a mantissa of 0 denotes infinity.
        An exponent of 2047 and a mantissa of #0 denotes NaN.
in NNMathL.Dep.Kep *)
PROCEDURE tan* (x: LONGREAL): LONGREAL;
    VAR neg: BOOLEAN; y, s1: LONGREAL;
BEGIN
    y := x - ENTIER(x / MathL.pi) * MathL.pi;
    IF y > piOver2 THEN neg := TRUE ELSE neg := FALSE END;
    s1 := MathL.sin(y);
    IF neg THEN RETURN - s1 / MathL.sqrt(1 - s1 * s1) ELSE RETURN s1 / MathL.sqrt(1 - s1 * s1) END
END tan;
PROCEDURE cot* (x: LONGREAL): LONGREAL;
    BEGIN RETURN 1 / tan(x) END cot;
PROCEDURE arcsin* (x: LONGREAL): LONGREAL;
    BEGIN RETURN MathL.arctan(x / MathL.sqrt(1 - x * x)) END arcsin;
PROCEDURE arccot* (x: LONGREAL): LONGREAL;
    BEGIN RETURN piOver2 - MathL.arctan(x) END arccot;
PROCEDURE arccos* (x: LONGREAL): LONGREAL;
    BEGIN RETURN piOver2 - arcsin(x) END arccos;
PROCEDURE tanh* (x: LONGREAL): LONGREAL;
    VAR e1, e2, e3, e4, e5, e6, t1, t2: LONGREAL;
BEGIN
    IF ABS(x) < 3.7D-9 THEN RETURN x
    ELSIF x >= 20.101 THEN RETURN 1
    ELSIF x <= -0.54931D0 THEN RETURN - tanh(-x)
    ELSIF x >= 0.54931 THEN RETURN 1 - 2 / (MathL.exp(2 * x) + 1)
    ELSE
        (* with Mathematica:
            <<Calculus`Pade`
            N[EconomizedRationalApproximation[Tanh[x], {x, {-0.1, 0.6}, 6, 6}], 20]
        e1 := (-0.25 + x); e2 := e1 * (-0.25 + x); e3 := e2 * (-0.25 + x); e4 := e3 * (-0.25 + x);
        e5 := e4 * (-0.25 + x); e6 := e5 * (-0.25 + x);
        t1 := 0.00002356119887556018 * e6 + 0.002023148148112773 * e5 +
            0.004958685234944415 * e4 + 0.1215218750947677 * e3 +
            0.1116301731341965 * e2 + 1.002788402136751 * e1 + 0.2456015941258246;
        t2 := 0.0000962000961977488 * e6 + 0.0004955067381496328 * e5 +
            0.02024625313240082 * e4 + 0.02976297509725574 * e3 +
            0.4557846758065249 * e2 + 0.2456015941168399 * e1 + 1.002788402138951;
        RETURN t1 / t2
    END;
END tanh;
PROCEDURE sinh* (x: LONGREAL): LONGREAL;
    VAR t1: LONGREAL;
BEGIN
    t1 := tanh(x);
    RETURN t1 / MathL.sqrt(1 - t1 * t1)
END sinh;
PROCEDURE cosh* (x: LONGREAL): LONGREAL;
    VAR t1: LONGREAL;
BEGIN
    t1 := tanh(x);
    RETURN 1 / MathL.sqrt(1 - t1 * t1)
END cosh;
PROCEDURE coth* (x: LONGREAL): LONGREAL;
    VAR e1, e2: LONGREAL;
BEGIN
    e1 := MathL.exp(x); e2 := 1 / e1;
    RETURN (e1 + e2) / (e1 - e2)
END coth;
PROCEDURE arctanh* (x: LONGREAL): LONGREAL;
    BEGIN RETURN 0.5 * MathL.ln((1 + x) / (1 - x)) END arctanh;
PROCEDURE arcsinh* (x: LONGREAL): LONGREAL;
    BEGIN RETURN arctanh(x / MathL.sqrt(1 + x * x)) END arcsinh;
PROCEDURE arcosh* (x: LONGREAL): LONGREAL;
    BEGIN RETURN arctanh(MathL.sqrt(x * x - 1) / x) END arcosh;
PROCEDURE arcoth* (x: LONGREAL): LONGREAL;
    BEGIN RETURN arctanh(1 / x) END arcoth;
END MoreMathL.Mod